home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / gg / ncurses-5.3.lha / ncurses-5.3 / Ada95 / samples / ncurses2-acs_and_scroll.adb < prev    next >
Text File  |  2002-10-24  |  26KB  |  723 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                       GNAT ncurses Binding Samples                       --
  4. --                                                                          --
  5. --                                 ncurses                                  --
  6. --                                                                          --
  7. --                                 B O D Y                                  --
  8. --                                                                          --
  9. ------------------------------------------------------------------------------
  10. -- Copyright (c) 2000 Free Software Foundation, Inc.                        --
  11. --                                                                          --
  12. -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13. -- copy of this software and associated documentation files (the            --
  14. -- "Software"), to deal in the Software without restriction, including      --
  15. -- without limitation the rights to use, copy, modify, merge, publish,      --
  16. -- distribute, distribute with modifications, sublicense, and/or sell       --
  17. -- copies of the Software, and to permit persons to whom the Software is    --
  18. -- furnished to do so, subject to the following conditions:                 --
  19. --                                                                          --
  20. -- The above copyright notice and this permission notice shall be included  --
  21. -- in all copies or substantial portions of the Software.                   --
  22. --                                                                          --
  23. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30. --                                                                          --
  31. -- Except as contained in this notice, the name(s) of the above copyright   --
  32. -- holders shall not be used in advertising or otherwise to promote the     --
  33. -- sale, use or other dealings in this Software without prior written       --
  34. -- authorization.                                                           --
  35. ------------------------------------------------------------------------------
  36. --  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
  37. --  Version Control
  38. --  $Revision: 1.1 $
  39. --  Binding Version 01.00
  40. ------------------------------------------------------------------------------
  41. --  Windows and scrolling tester.
  42. --  Demonstrate windows
  43.  
  44. with Ada.Strings.Fixed;
  45. with Ada.Strings;
  46.  
  47. with ncurses2.util; use ncurses2.util;
  48. with ncurses2.genericPuts;
  49. with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  50. with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
  51. with Terminal_Interface.Curses.PutWin; use Terminal_Interface.Curses.PutWin;
  52.  
  53. with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
  54. with Ada.Streams; use Ada.Streams;
  55.  
  56. procedure ncurses2.acs_and_scroll is
  57.  
  58.  
  59.    Macro_Quit   : constant Key_Code := Character'Pos ('Q') mod 16#20#;
  60.    Macro_Escape : constant Key_Code := Character'Pos ('[') mod 16#20#;
  61.  
  62.    Quit : constant Key_Code := CTRL ('Q');
  63.    Escape : constant Key_Code := CTRL ('[');
  64.  
  65.  
  66.    Botlines : constant Line_Position := 4;
  67.  
  68.    type pair is record
  69.       y : Line_Position;
  70.       x : Column_Position;
  71.    end record;
  72.  
  73.    type Frame;
  74.    type FrameA is access Frame;
  75.  
  76.    f : File_Type;
  77.    dumpfile : constant String := "screendump";
  78.  
  79.    procedure Outerbox (ul, lr : pair; onoff : Boolean);
  80.    function  HaveKeyPad (w : Window) return Boolean;
  81.    function  HaveScroll (w : Window) return Boolean;
  82.    procedure newwin_legend (curpw : Window);
  83.    procedure transient (curpw : Window; msg : String);
  84.    procedure newwin_report (win : Window := Standard_Window);
  85.    procedure selectcell (uli : Line_Position;
  86.                          ulj : Column_Position;
  87.                          lri : Line_Position;
  88.                          lrj : Column_Position;
  89.                          p   : out pair;
  90.                          b   : out Boolean);
  91.    function  getwindow return Window;
  92.    procedure newwin_move (win : Window;
  93.                           dy  : Line_Position;
  94.                           dx  : Column_Position);
  95.    function delete_framed (fp : FrameA; showit : Boolean) return FrameA;
  96.  
  97.    use Ada.Streams.Stream_IO;
  98.  
  99.  
  100.    --  A linked list
  101.    --  I  wish there was a standard library linked list. Oh well.
  102.    type Frame is record
  103.       next, last : FrameA;
  104.       do_scroll : Boolean;
  105.       do_keypad : Boolean;
  106.       wind : Window;
  107.    end record;
  108.  
  109.    current : FrameA;
  110.  
  111.    c : Key_Code;
  112.  
  113.    procedure Outerbox (ul, lr : pair; onoff : Boolean) is
  114.    begin
  115.       if onoff then
  116.          --  Note the fix of an obscure bug
  117.          --  try making a 1x1 box then enlarging it, the is a blank
  118.          --  upper left corner!
  119.          Add (Line => ul.y - 1, Column => ul.x - 1,
  120.              Ch => ACS_Map (ACS_Upper_Left_Corner));
  121.          Add (Line => ul.y - 1, Column => lr.x + 1,
  122.              Ch => ACS_Map (ACS_Upper_Right_Corner));
  123.          Add (Line => lr.y + 1, Column => lr.x + 1,
  124.              Ch => ACS_Map (ACS_Lower_Right_Corner));
  125.          Add (Line => lr.y + 1, Column => ul.x - 1,
  126.              Ch => ACS_Map (ACS_Lower_Left_Corner));
  127.  
  128.          Move_Cursor (Line => ul.y - 1, Column => ul.x);
  129.          Horizontal_Line (Line_Symbol => ACS_Map (ACS_Horizontal_Line),
  130.                           Line_Size => Integer (lr.x - ul.x) + 1);
  131.          Move_Cursor (Line => ul.y, Column => ul.x - 1);
  132.          Vertical_Line (Line_Symbol => ACS_Map (ACS_Vertical_Line),
  133.                         Line_Size => Integer (lr.y - ul.y) + 1);
  134.          Move_Cursor (Line => lr.y + 1, Column => ul.x);
  135.          Horizontal_Line (Line_Symbol => ACS_Map (ACS_Horizontal_Line),
  136.                           Line_Size => Integer (lr.x - ul.x) + 1);
  137.          Move_Cursor (Line => ul.y, Column => lr.x + 1);
  138.          Vertical_Line (Line_Symbol => ACS_Map (ACS_Vertical_Line),
  139.                         Line_Size => Integer (lr.y - ul.y) + 1);
  140.       else
  141.          Add (Line => ul.y - 1, Column => ul.x - 1, Ch => ' ');
  142.          Add (Line => ul.y - 1, Column => lr.x + 1, Ch => ' ');
  143.          Add (Line => lr.y + 1, Column => lr.x + 1, Ch => ' ');
  144.          Add (Line => lr.y + 1, Column => ul.x - 1, Ch => ' ');
  145.  
  146.          Move_Cursor (Line => ul.y - 1, Column => ul.x);
  147.          Horizontal_Line (Line_Symbol => Blank2,
  148.                           Line_Size => Integer (lr.x - ul.x) + 1);
  149.          Move_Cursor (Line => ul.y, Column => ul.x - 1);
  150.          Vertical_Line (Line_Symbol => Blank2,
  151.                         Line_Size => Integer (lr.y - ul.y) + 1);
  152.          Move_Cursor (Line => lr.y + 1, Column => ul.x);
  153.          Horizontal_Line (Line_Symbol => Blank2,
  154.                           Line_Size => Integer (lr.x - ul.x) + 1);
  155.          Move_Cursor (Line => ul.y, Column => lr.x + 1);
  156.          Vertical_Line (Line_Symbol => Blank2,
  157.                         Line_Size => Integer (lr.y - ul.y) + 1);
  158.       end if;
  159.    end Outerbox;
  160.  
  161.    function HaveKeyPad (w : Window) return Boolean is
  162.    begin
  163.       return Get_KeyPad_Mode (w);
  164.    exception
  165.       when Curses_Exception => return False;
  166.    end HaveKeyPad;
  167.  
  168.    function HaveScroll (w : Window) return Boolean is
  169.    begin
  170.       return Scrolling_Allowed (w);
  171.    exception
  172.       when Curses_Exception => return False;
  173.    end HaveScroll;
  174.  
  175.  
  176.    procedure newwin_legend (curpw : Window) is
  177.  
  178.       package p is new genericPuts (200);
  179.       use p;
  180.       use p.BS;
  181.  
  182.       type string_a is access String;
  183.  
  184.       type rrr is record
  185.          msg : string_a;
  186.          code : Integer range 0 .. 3;
  187.       end record;
  188.  
  189.       legend : constant array (Positive range <>) of rrr :=
  190.         (
  191.          (
  192.           new String'("^C = create window"), 0
  193.           ),
  194.          (
  195.           new String'("^N = next window"), 0
  196.           ),
  197.          (
  198.           new String'("^P = previous window"), 0
  199.           ),
  200.          (
  201.           new String'("^F = scroll forward"), 0
  202.           ),
  203.          (
  204.           new String'("^B = scroll backward"), 0
  205.           ),
  206.          (
  207.           new String'("^K = keypad(%s)"), 1
  208.           ),
  209.          (
  210.           new String'("^S = scrollok(%s)"), 2
  211.           ),
  212.          (
  213.           new String'("^W = save window to file"), 0
  214.           ),
  215.          (
  216.           new String'("^R = restore window"), 0
  217.           ),
  218.          (
  219.           new String'("^X = resize"), 0
  220.           ),
  221.          (
  222.           new String'("^Q%s = exit"), 3
  223.           )
  224.          );
  225.  
  226.       buf : Bounded_String;
  227.       do_keypad : Boolean := HaveKeyPad (curpw);
  228.       do_scroll : Boolean := HaveScroll (curpw);
  229.  
  230.       pos : Natural;
  231.  
  232.       mypair : pair;
  233.  
  234.       use Ada.Strings.Fixed;
  235.  
  236.    begin
  237.       Move_Cursor (Line => Lines - 4, Column => 0);
  238.       for n in legend'Range loop
  239.          pos := Ada.Strings.Fixed.Index (Source => legend (n).msg.all,
  240.                                          Pattern => "%s");
  241.          --  buf := (others => ' ');
  242.          buf := To_Bounded_String (legend (n).msg.all);
  243.          case legend (n).code is
  244.             when 0 => null;
  245.             when 1 =>
  246.                if do_keypad then
  247.                   Replace_Slice (buf, pos, pos + 1, "yes");
  248.                else
  249.                   Replace_Slice (buf, pos, pos + 1, "no");
  250.                end if;
  251.             when 2 =>
  252.                if do_scroll then
  253.                   Replace_Slice (buf, pos, pos + 1, "yes");
  254.                else
  255.                   Replace_Slice (buf, pos, pos + 1, "no");
  256.                end if;
  257.             when 3 =>
  258.                if do_keypad then
  259.                   Replace_Slice (buf, pos, pos + 1, "/ESC");
  260.                else
  261.                   Replace_Slice (buf, pos, pos + 1, "");
  262.                end if;
  263.          end case;
  264.          Get_Cursor_Position (Line => mypair.y, Column => mypair.x);
  265.          if Columns < mypair.x + 3 + Column_Position (Length (buf)) then
  266.             Add (Ch => newl);
  267.          elsif n /= 1 then -- n /= legen'First
  268.             Add (Str => ", ");
  269.          end if;
  270.          myAdd (Str => buf);
  271.       end loop;
  272.       Clear_To_End_Of_Line;
  273.    end newwin_legend;
  274.  
  275.  
  276.    procedure transient (curpw : Window; msg : String) is
  277.    begin
  278.       newwin_legend (curpw);
  279.       if msg /= "" then
  280.          Add (Line => Lines - 1, Column => 0, Str => msg);
  281.          Refresh;
  282.          Nap_Milli_Seconds (1000);
  283.       end if;
  284.  
  285.       Move_Cursor (Line => Lines - 1, Column => 0);
  286.  
  287.       if HaveKeyPad (curpw) then
  288.          Add (Str => "Non-arrow");
  289.       else
  290.          Add (Str => "All other");
  291.       end if;
  292.       Add (str => " characters are echoed, window should ");
  293.       if not HaveScroll (curpw) then
  294.          Add (Str => "not ");
  295.       end if;
  296.       Add (str => "scroll");
  297.  
  298.       Clear_To_End_Of_Line;
  299.    end transient;
  300.  
  301.  
  302.    procedure newwin_report (win : Window := Standard_Window) is
  303.       y : Line_Position;
  304.       x : Column_Position;
  305.       use Int_IO;
  306.       tmp2a : String (1 .. 2);
  307.       tmp2b : String (1 .. 2);
  308.    begin
  309.       if win /= Standard_Window then
  310.          transient (win, "");
  311.       end if;
  312.       Get_Cursor_Position (win, y, x);
  313.       Move_Cursor (Line => Lines - 1, Column => Columns - 17);
  314.       Put (tmp2a, Integer (y));
  315.       Put (tmp2b, Integer (x));
  316.       Add (Str => "Y = " & tmp2a & " X = " & tmp2b);
  317.       if win /= Standard_Window then
  318.          Refresh;
  319.       else
  320.          Move_Cursor (win, y, x);
  321.       end if;
  322.    end newwin_report;
  323.  
  324.    procedure selectcell (uli : Line_Position;
  325.                          ulj : Column_Position;
  326.                          lri : Line_Position;
  327.                          lrj : Column_Position;
  328.                          p   : out pair;
  329.                          b   : out Boolean) is
  330.       c : Key_Code;
  331.       res : pair;
  332.       i : Line_Position := 0;
  333.       j : Column_Position := 0;
  334.       si : Line_Position := lri - uli + 1;
  335.       sj : Column_Position := lrj - ulj + 1;
  336.    begin
  337.       res.y := uli;
  338.       res.x := ulj;
  339.       loop
  340.          Move_Cursor (Line => uli + i, Column => ulj + j);
  341.          newwin_report;
  342.  
  343.          c := Getchar;
  344.          case c is
  345.             when
  346.               Macro_Quit   |
  347.               Macro_Escape =>
  348.                --  on the same line macro calls interfere due to the # comment
  349.                --  this is needed because keypad off affects all windows.
  350.                --  try removing the ESCAPE and see what happens.
  351.                b := False;
  352.                return;
  353.             when KEY_UP =>
  354.                i := i + si - 1;
  355.                --  same as  i := i - 1 because of Modulus arithetic,
  356.                --  on Line_Position, which is a Natural
  357.                --  the C version uses this form too, interestingly.
  358.             when KEY_DOWN =>
  359.                i := i + 1;
  360.             when KEY_LEFT =>
  361.                j := j + sj - 1;
  362.             when KEY_RIGHT =>
  363.                j := j + 1;
  364.             when Key_Mouse =>
  365.                declare
  366.                   event : Mouse_Event;
  367.                   y : Line_Position;
  368.                   x : Column_Position;
  369.                   Button : Mouse_Button;
  370.                   State : Button_State;
  371.  
  372.                begin
  373.                   event := Get_Mouse;
  374.                   Get_Event (Event => event,
  375.                              Y => y,
  376.                              X => x,
  377.                              Button => Button,
  378.                              State  => State);
  379.                   if y > uli and x > ulj then
  380.                      i := y - uli;
  381.                      j := x - ulj;
  382.                      --  same as when others =>
  383.                      res.y := uli + i;
  384.                      res.x := ulj + j;
  385.                      p := res;
  386.                      b := True;
  387.                      return;
  388.                   else
  389.                      Beep;
  390.                   end if;
  391.                end;
  392.             when others =>
  393.                res.y := uli + i;
  394.                res.x := ulj + j;
  395.                p := res;
  396.                b := True;
  397.                return;
  398.          end case;
  399.          i := i mod si;
  400.          j := j mod sj;
  401.       end loop;
  402.    end selectcell;
  403.  
  404.  
  405.    function getwindow return Window is
  406.       rwindow : Window;
  407.       ul, lr : pair;
  408.       result : Boolean;
  409.    begin
  410.       Move_Cursor (Line => 0, Column => 0);
  411.       Clear_To_End_Of_Line;
  412.       Add (Str => "Use arrows to move cursor, anything else to mark corner 1");
  413.       Refresh;
  414.       selectcell (2, 1, Lines - Botlines - 2, Columns - 2, ul, result);
  415.       if not result then
  416.          return Null_Window;
  417.       end if;
  418.       Add (Line => ul.y - 1, Column => ul.x - 1,
  419.            Ch => ACS_Map (ACS_Upper_Left_Corner));
  420.       Move_Cursor (Line => 0, Column => 0);
  421.       Clear_To_End_Of_Line;
  422.       Add (Str => "Use arrows to move cursor, anything else to mark corner 2");
  423.       Refresh;
  424.       selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2, lr, result);
  425.       if not result then
  426.          return Null_Window;
  427.       end if;
  428.  
  429.       rwindow := Sub_Window (Number_Of_Lines => lr.y - ul.y + 1,
  430.                              Number_Of_Columns => lr.x - ul.x + 1,
  431.                              First_Line_Position => ul.y,
  432.                              First_Column_Position => ul.x);
  433.  
  434.       Outerbox (ul, lr, True);
  435.       Refresh;
  436.  
  437.       Refresh (rwindow);
  438.  
  439.       Move_Cursor (Line => 0, Column => 0);
  440.       Clear_To_End_Of_Line;
  441.       return rwindow;
  442.    end getwindow;
  443.  
  444.  
  445.    procedure newwin_move (win : Window;
  446.                           dy  : Line_Position;
  447.                           dx  : Column_Position) is
  448.       cur_y, max_y : Line_Position;
  449.       cur_x, max_x : Column_Position;
  450.    begin
  451.       Get_Cursor_Position (win, cur_y, cur_x);
  452.       Get_Size (win, max_y, max_x);
  453.       cur_x := Column_Position'Min (Column_Position'Max (cur_x + dx, 0),
  454.                                     max_x - 1);
  455.       cur_y := Line_Position'Min (Line_Position'Max (cur_y + dy, 0),
  456.                                   max_y - 1);
  457.  
  458.       Move_Cursor (win, Line => cur_y, Column => cur_x);
  459.    end newwin_move;
  460.  
  461.    function delete_framed (fp : FrameA; showit : Boolean) return FrameA is
  462.       np : FrameA;
  463.    begin
  464.       fp.last.next := fp.next;
  465.       fp.next.last := fp.last;
  466.  
  467.       if showit then
  468.          Erase (fp.wind);
  469.          Refresh (fp.wind);
  470.       end if;
  471.       Delete (fp.wind);
  472.  
  473.       if fp = fp.next then
  474.          np := null;
  475.       else
  476.          np := fp.next;
  477.       end if;
  478.       --  TODO free(fp);
  479.       return np;
  480.    end delete_framed;
  481.  
  482.    Mask : Event_Mask := No_Events;
  483.    Mask2 : Event_Mask;
  484.  
  485.    usescr : Window;
  486.  
  487. begin
  488.    if Has_Mouse then
  489.       Register_Reportable_Event (
  490.                                  Button => Left,
  491.                                  State => Clicked,
  492.                                  Mask => Mask);
  493.       Mask2 := Start_Mouse (Mask);
  494.    end if;
  495.    c := CTRL ('C');
  496.    Set_Raw_Mode (SwitchOn => True);
  497.    loop
  498.       transient (Standard_Window, "");
  499.       case c is
  500.          when Character'Pos ('c') mod 16#20# => --  Ctrl('c')
  501.             declare
  502.                neww : FrameA := new Frame'(null, null, False, False,
  503.                                            Null_Window);
  504.             begin
  505.                neww.wind := getwindow;
  506.                if neww.wind = Null_Window  then
  507.                   exit;
  508.                   --  was goto breakout; ha ha ha
  509.                else
  510.  
  511.                   if current = null  then
  512.                      neww.next := neww;
  513.                      neww.last := neww;
  514.                   else
  515.                      neww.next := current.next;
  516.                      neww.last := current;
  517.                      neww.last.next := neww;
  518.                      neww.next.last := neww;
  519.                   end if;
  520.                   current := neww;
  521.  
  522.                   Set_KeyPad_Mode (current.wind, True);
  523.                   current.do_keypad := HaveKeyPad (current.wind);
  524.                   current.do_scroll := HaveScroll (current.wind);
  525.                end if;
  526.             end;
  527.          when Character'Pos ('N') mod 16#20#  => --  Ctrl('N')
  528.             if current /= null then
  529.                current := current.next;
  530.             end if;
  531.          when Character'Pos ('P') mod 16#20#  => --  Ctrl('P')
  532.             if current /= null then
  533.                current := current.last;
  534.             end if;
  535.          when Character'Pos ('F') mod 16#20#  => --  Ctrl('F')
  536.             if current /= null and HaveScroll (current.wind) then
  537.                Scroll (current.wind, 1);
  538.             end if;
  539.          when Character'Pos ('B') mod 16#20#  => --  Ctrl('B')
  540.             if current /= null and HaveScroll (current.wind) then
  541.             --  The C version of Scroll may return ERR which is ignored
  542.             --  we need to avoid the exception
  543.             --  with the 'and HaveScroll(current.wind)'
  544.                Scroll (current.wind, -1);
  545.             end if;
  546.          when Character'Pos ('K') mod 16#20#  => --  Ctrl('K')
  547.             if current /= null then
  548.                current.do_keypad := not current.do_keypad;
  549.                Set_KeyPad_Mode (current.wind, current.do_keypad);
  550.             end if;
  551.          when Character'Pos ('S') mod 16#20#  => --  Ctrl('S')
  552.             if current /= null then
  553.                current.do_scroll := not current.do_scroll;
  554.                Allow_Scrolling (current.wind, current.do_scroll);
  555.             end if;
  556.          when Character'Pos ('W') mod 16#20#  => --  Ctrl('W')
  557.             if current /= current.next then
  558.                Create (f, Name => dumpfile); -- TODO error checking
  559.                if not Is_Open (f) then
  560.                   raise Curses_Exception;
  561.                end if;
  562.                Put_Window (current.wind, f);
  563.                Close (f);
  564.                current := delete_framed (current, True);
  565.             end if;
  566.          when Character'Pos ('R') mod 16#20#  => --  Ctrl('R')
  567.             declare
  568.                neww : FrameA := new Frame'(null, null, False, False,
  569.                                            Null_Window);
  570.             begin
  571.                Open (f, Mode => In_File, Name => dumpfile);
  572.                neww := new Frame'(null, null, False, False, Null_Window);
  573.  
  574.                neww.next := current.next;
  575.                neww.last := current;
  576.                neww.last.next := neww;
  577.                neww.next.last := neww;
  578.  
  579.                neww.wind := Get_Window (f);
  580.                Close (f);
  581.  
  582.                Refresh (neww.wind);
  583.             end;
  584.          when Character'Pos ('X') mod 16#20# => --  Ctrl('X')
  585.             if current /= null then
  586.                declare
  587.                   tmp, ul, lr : pair;
  588.                   mx : Column_Position;
  589.                   my : Line_Position;
  590.                   tmpbool : Boolean;
  591.                begin
  592.                   Move_Cursor (Line => 0, Column => 0);
  593.                   Clear_To_End_Of_Line;
  594.                   Add (Str => "Use arrows to move cursor, anything else " &
  595.                        "to mark new corner");
  596.                   Refresh;
  597.  
  598.                   Get_Window_Position (current.wind, ul.y, ul.x);
  599.  
  600.                   selectcell (ul.y, ul.x, Lines - Botlines - 2, Columns - 2,
  601.                               tmp, tmpbool);
  602.                   if not tmpbool then
  603.                      --  the C version had a goto. I refuse gotos.
  604.                      Beep;
  605.                   else
  606.                      Get_Size (current.wind, lr.y, lr.x);
  607.                      lr.y := lr.y + ul.y - 1;
  608.                      lr.x := lr.x + ul.x - 1;
  609.                      Outerbox (ul, lr, False);
  610.                      Refresh_Without_Update;
  611.  
  612.                      Get_Size (current.wind, my, mx);
  613.                      if my > tmp.y - ul.y then
  614.                         Get_Cursor_Position (current.wind, lr.y, lr.x);
  615.                         Move_Cursor (current.wind, tmp.y - ul.y + 1, 0);
  616.                         Clear_To_End_Of_Screen (current.wind);
  617.                         Move_Cursor (current.wind, lr.y, lr.x);
  618.                      end if;
  619.                      if mx > tmp.x - ul.x then
  620.                         for i in 0 .. my - 1 loop
  621.                            Move_Cursor (current.wind, i, tmp.x - ul.x + 1);
  622.                            Clear_To_End_Of_Line (current.wind);
  623.                         end loop;
  624.                      end if;
  625.                      Refresh_Without_Update (current.wind);
  626.  
  627.                      lr := tmp;
  628.                      --  The C version passes invalid args to resize
  629.                      --  which returns an ERR. For Ada we avoid the exception.
  630.                      if lr.y /= ul.y and lr.x /= ul.x then
  631.                         Resize (current.wind, lr.y - ul.y + 0,
  632.                                 lr.x - ul.x + 0);
  633.                      end if;
  634.  
  635.                      Get_Window_Position (current.wind, ul.y, ul.x);
  636.                      Get_Size (current.wind, lr.y, lr.x);
  637.                      lr.y := lr.y + ul.y - 1;
  638.                      lr.x := lr.x + ul.x - 1;
  639.                      Outerbox (ul, lr, True);
  640.                      Refresh_Without_Update;
  641.  
  642.                      Refresh_Without_Update (current.wind);
  643.                      Move_Cursor (Line => 0, Column => 0);
  644.                      Clear_To_End_Of_Line;
  645.                      Update_Screen;
  646.                   end if;
  647.                end;
  648.             end if;
  649.          when Key_F10  =>
  650.             declare tmp : pair; tmpbool : Boolean;
  651.             begin
  652.                --  undocumented --- use this to test area clears
  653.                selectcell (0, 0, Lines - 1, Columns - 1, tmp, tmpbool);
  654.                Clear_To_End_Of_Screen;
  655.                Refresh;
  656.             end;
  657.          when Key_Cursor_Up =>
  658.             newwin_move (current.wind, -1, 0);
  659.          when Key_Cursor_Down  =>
  660.             newwin_move (current.wind, 1, 0);
  661.          when Key_Cursor_Left  =>
  662.             newwin_move (current.wind, 0, -1);
  663.          when Key_Cursor_Right  =>
  664.             newwin_move (current.wind, 0, 1);
  665.          when Key_Backspace | Key_Delete_Char  =>
  666.             declare
  667.                y : Line_Position;
  668.                x : Column_Position;
  669.                tmp : Line_Position;
  670.             begin
  671.                Get_Cursor_Position (current.wind, y, x);
  672.                --  x := x - 1;
  673.                --  I got tricked by the -1 = Max_Natural - 1 result
  674.                --  y := y - 1;
  675.                if not (x = 0 and y = 0) then
  676.                   if x = 0 then
  677.                      y := y - 1;
  678.                      Get_Size (current.wind, tmp, x);
  679.                   end if;
  680.                   x := x - 1;
  681.                   Delete_Character (current.wind, y, x);
  682.                end if;
  683.             end;
  684.          when others =>
  685.             --  TODO c = '\r' ?
  686.             if current /= null then
  687.                declare
  688.                begin
  689.                   Add (current.wind, Ch => Code_To_Char (c));
  690.                exception
  691.                   when Curses_Exception => null;
  692.                      --  this happens if we are at the
  693.                      --  lower right of a window and add a character.
  694.                end;
  695.             else
  696.                Beep;
  697.             end if;
  698.       end case;
  699.       newwin_report (current.wind);
  700.       if current /= null then
  701.          usescr := current.wind;
  702.       else
  703.          usescr := Standard_Window;
  704.       end if;
  705.       Refresh (usescr);
  706.       c := Getchar (usescr);
  707.       exit when c = Quit or (c = Escape and HaveKeyPad (usescr));
  708.       --  TODO when does c = ERR happen?
  709.    end loop;
  710.  
  711.    --  TODO while current /= null loop
  712.    --  current := delete_framed(current, False);
  713.    --  end loop;
  714.  
  715.    Allow_Scrolling (Mode => True);
  716.  
  717.    End_Mouse;
  718.    Set_Raw_Mode (SwitchOn => True);
  719.    Erase;
  720.    End_Windows;
  721.  
  722. end ncurses2.acs_and_scroll;
  723.